home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / psgml / psgml-charent.el.z / psgml-charent.el
Encoding:
Text File  |  1998-05-21  |  3.8 KB  |  119 lines
  1. ;;;; psgml-charent.el
  2. ;;; Last edited: Mon Nov 28 22:18:09 1994 by lenst@lysistrate (Lennart Staflin)
  3. ;;; $Id: psgml-charent.el,v 1.2 1994/12/04 13:55:04 lenst Released $
  4.  
  5. ;; Copyright (C) 1994 Lennart Staflin
  6.  
  7. ;; Author: Steinar Bang, Falch Hurtigtrykk as., Oslo, 940711
  8. ;;    Lennart Staflin <lenst@lysator.liu.se>
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License
  12. ;; as published by the Free Software Foundation; either version 2
  13. ;; of the License, or (at your option) any later version.
  14. ;; 
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19. ;; 
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this program; if not, write to the Free Software
  22. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24.  
  25. ;;;; Commentary:
  26.  
  27. ;;  Functions to convert character entities into displayable characters
  28. ;;  and displayable characters back into character entities.
  29.  
  30.  
  31. ;;;; Code:
  32.  
  33. (provide 'psgml-charent)
  34. (require 'psgml-parse)
  35.  
  36.  
  37. ;;;; Variable declarations
  38.  
  39. (defvar sgml-display-char-list-filename
  40.   (concat (locate-data-directory "sgml") "iso88591.map")
  41.   "*Name of file holding relations between character codes and character
  42. names of displayable characters")
  43.  
  44. (defvar sgml-display-char-alist-cache nil)
  45.  
  46.  
  47. ;;;; Function declarations
  48.  
  49. (defun sgml-display-char-alist ()
  50.   "Return the current display character alist.
  51. Alist with entity name as key and display character as content."
  52.   (unless (file-exists-p sgml-display-char-list-filename)
  53.     (error "No display char file: %s"
  54.        sgml-display-char-list-filename))
  55.   (sgml-cache-catalog sgml-display-char-list-filename 
  56.               'sgml-display-char-alist-cache
  57.               (function sgml-read-display-char-alist)))
  58.  
  59. (defun sgml-read-display-char-alist ()
  60.   (let (key disp-char alist)
  61.     (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\(.+\\)$" nil t)
  62.       (setq key (buffer-substring (match-beginning 2) (match-end 2)))
  63.       (setq disp-char
  64.         (char-to-string
  65.          (string-to-number
  66.           (buffer-substring (match-beginning 1) (match-end 1)))))
  67.       (push (cons key disp-char)
  68.         alist))
  69.     alist))
  70.  
  71. (defun sgml-charent-to-dispchar-alist ()
  72.   "Association list to hold relations of the type
  73.      (CHARACTER-NAME . CHARACTER)
  74.     where 
  75.      CHARACTER-NAME is a string holding a character name
  76.      CHARACTER      is a string holding a single displayable character"
  77.   (sgml-need-dtd)
  78.   (let ((display-chars (sgml-display-char-alist))
  79.     (alist nil))
  80.     (sgml-map-entities
  81.      (function
  82.       (lambda (entity)
  83.     (let ((char (cdr (assoc (sgml-entity-text entity)
  84.                 display-chars))))
  85.       (when char
  86.         (push (cons (sgml-entity-name entity) char) alist)))))
  87.      (sgml-dtd-entities sgml-dtd-info))
  88.     
  89.     alist))
  90.  
  91.  
  92. (defun sgml-charent-to-display-char ()
  93.   "Replace character entities with their display character equivalents"
  94.   (interactive)
  95.   (let ((charent-to-char
  96.      (sgml-charent-to-dispchar-alist))
  97.     charent replacement)
  98.     (save-excursion
  99.       (goto-char (point-min))
  100.       (sgml-with-parser-syntax
  101.        (while (re-search-forward "&\\(\\w\\(\\w\\|\\s_\\)+\\);?" nil t)
  102.      (setq charent (buffer-substring (match-beginning 1) (match-end 1)))
  103.      (if (setq replacement (cdr (assoc charent charent-to-char)))
  104.          (replace-match replacement t t)))))))
  105.  
  106. (defun sgml-display-char-to-charent ()
  107.   "Replace displayable characters with their character entity equivalents"
  108.   (interactive)
  109.   (let ((case-fold-search nil))
  110.     (save-excursion
  111.       (loop for pair in (sgml-charent-to-dispchar-alist)
  112.         do (goto-char (point-min))
  113.         (while (search-forward (cdr pair) nil t)
  114.           (replace-match (concat "&" (car pair) ";") t t))))))
  115.  
  116.  
  117.  
  118. ;;; psgml-charent.el ends here
  119.